home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / SelfNews / wireIPS.cps < prev   
Text File  |  1993-07-24  |  4KB  |  160 lines
  1. % File wireIPS.cps
  2. % created by Ian Wilkinson on Sat Sep 12 22:51:33 1992
  3. %
  4. % Copyright (c) Canon Research Centre Europe, 1992.
  5. % All rights reserved.
  6.  
  7. cdef PSloadPackages()
  8.     /NeWS    3 0 findpackage beginpackage
  9.     /TNTCore 3 0 findpackage beginpackage
  10.     /TNT     3 0 findpackage beginpackage
  11.  
  12.     /ClassGeneric nullarray
  13.     dictbegin
  14.     /offsetX    0    def
  15.     /offsetY    0    def
  16.     dictend
  17.     classbegin
  18.     /methoddict { % [ argNames ] [ localNames ] => dict
  19.         0
  20.         2 index    {
  21.         dup null eq {
  22.             pop 
  23.         }{
  24.             /promoted? self send not { 1 add } if
  25.         } ifelse
  26.         } forall
  27.  
  28.         1 index length add dict
  29.         begin
  30.         { null def } forall
  31.  
  32.         arrayreverse {
  33.             dup null eq {
  34.             pop pop
  35.             }{
  36.             dup /promoted? self send
  37.             { exch store } { exch def } ifelse
  38.             } ifelse
  39.         } forall
  40.  
  41.         currentdict
  42.         end
  43.     } def
  44.  
  45.     /methodstacktodict { % [ argNames ] => -
  46.         arrayreverse {
  47.         dup null eq {
  48.             pop pop
  49.         }{
  50.             dup /promoted? self send { exch store } { exch def } ifelse
  51.         } ifelse
  52.         } forall
  53.     } def
  54.  
  55.     /containingWindow { % - => canvas
  56.         [] [ /can ] methoddict
  57.         begin
  58.         /parents self send {
  59.             /can exch store
  60.             can /descendantof? ClassWindow send { exit } if
  61.         } forall
  62.         can framebuffer eq { null }{ can } ifelse
  63.         end
  64.     } def
  65.  
  66.     /installStdBehaviour { % - => -
  67.         [] [ /theMenu ] methoddict
  68.         begin
  69.         true /setdamageable self send
  70.         true /settrackable self send
  71.         true /setfrontable self send
  72.         true /setmenuable self send
  73.         /theMenu /Grid framebuffer /new ClassMenu send store
  74.         [
  75.             [ (Quit) /removeFromWorld ]
  76.         ] /setitemlist theMenu send
  77.         self /settarget theMenu send
  78.         theMenu /setmenu self send
  79.  
  80.         /TrackStart { % evt => /Default true
  81.             [ /evt ] [] methoddict
  82.             begin
  83.             /totop self send
  84.             gsave
  85.                 self setcanvas
  86.                 evt /Coordinates get aload pop 
  87.                 /offsetY exch store 
  88.                 /offsetX exch store
  89.             grestore
  90.             /Default true
  91.             end
  92.         } /installmethod self send
  93.  
  94.         /TrackMotion { % evt => -
  95.             /Coordinates get aload pop offsetX offsetY xysub
  96.             /move self send
  97.         } /installmethod self send
  98.         end
  99.     } def
  100.  
  101.     /messageSyncSelf { % [ args ... ] methodName object => -
  102.         [ /args /methodName /obj ] [ /wireProcF ] methoddict
  103.         begin
  104.         shareddict /MessageSelfProt get {
  105.             /wireProcF wireProcess /Stdout get store
  106.             wireProcess /Stdout shareddict /MessageSelf get put 
  107.             args methodName obj wiresendsync
  108.             wireProcess /Stdout wireProcF put
  109.         } monitor
  110.         end
  111.     } def
  112.  
  113.     /messageSelf { % [ args ... ] methodName object => -
  114.         [ /args /methodName /obj ] [] methoddict
  115.         begin
  116.         shareddict /MessageSelfProt get {
  117.             %%CHANGE.  Terrible hack.
  118.             wireProcess
  119.             /wireProcess 
  120.             {} fork dup suspendprocess
  121.             dup /Stdout shareddict /MessageSelf get put 
  122.             store
  123.             args methodName obj wiresend
  124.             /wireProcess exch store
  125.         } monitor
  126.         end
  127.     } def
  128.  
  129.     /removeFromWorld { % cntl => -
  130.         /unmap self send        %%CHANGE. Find remaining reference.
  131.         [] /QuitApp self messageSelf
  132.         pop EventMgr /destroy self send /destroy exch send
  133.     } def
  134.  
  135.     /vieForAttention { % - => -
  136.         /totop self send
  137.     } def
  138.     classend def
  139.  
  140.  
  141. cdef PSsend( postscript psFragment )
  142.     psFragment
  143.  
  144. cdef PSsendTo( token tk, postscript psFragment )
  145.     psFragment tk send
  146.  
  147. cdef PSsyncReply( int tk, postscript theReply )
  148.     [ theReply ] /wireresume tk shareddict /MessageMachine get getfileinputtoken send
  149.  
  150. #define JotViewAspects        2000
  151. cdef PSjotViewAspects( token tk ) => JotViewAspects( )
  152.     JotViewAspects tagprint
  153.     /wire_Tags tk send length typedprint
  154.  
  155. #define JotViewBehaviour    2001
  156. cdef PSjotViewBehaviour( token tk ) => JotViewBehaviour( )
  157.     JotViewBehaviour tagprint
  158.     /wire_Tags tk send dup length typedprint
  159.     { typedprint pop } forall
  160.